home *** CD-ROM | disk | FTP | other *** search
- unit Isbrinst;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, Grids, Buttons, StdCtrls, ExtCtrls,
- IsamTabl, IsamBrow;
-
- type
- TUeberschriftObject = class(TObject)
- Txt: String;
- Idx: Integer;
- Breite: Integer;
- Constructor Init(aTxt: String; aIdx: Integer; aBreite: Integer);
- end;
-
- TBrowserSetupDlg = class(TForm)
- StringGrid1: TStringGrid;
- UpBttn: TSpeedButton;
- DownBttn: TSpeedButton;
- OkBttn: TBitBtn;
- CancelBttn: TBitBtn;
- procedure FormCreate(Sender: TObject);
- procedure UpBttnClick(Sender: TObject);
- procedure DownBttnClick(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure OkBttnClick(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure CancelBttnClick(Sender: TObject);
- private
- SortList: TStringList;
- BrowserName: String;
- IniName : String;
- Table : TIsamTable;
- public
- { Public-Deklarationen }
- end;
-
- var
- BrowserSetupDlg: TBrowserSetupDlg;
-
- Procedure BrowserSetup(aParent: TForm; AppName,BrwName: String;
- Table: TIsamTable);
- Procedure GetArray(AStr: String; var Arr1,Arr2: Integer);
-
- implementation
-
- Uses IniFiles, UToolDll;
-
- {$R *.DFM}
-
- Constructor TUeberschriftObject.Init(aTxt: String; aIdx: Integer; aBreite: Integer);
- begin
- Txt:= aTxt;
- Idx:= aIdx;
- Breite:= aBreite;
- end;
-
- procedure TBrowserSetupDlg.FormCreate(Sender: TObject);
- var AktDir: String;
- begin
- SortList:= TStringList.Create;
- BrowserName:= 'ISAMBROWSER1';
- IniName:= 'ISAMTEST.INI';
- AktDir:= ExtractFilePath(Application.ExeName);
- IniName:= AktDir + ININame;
- if Sprache = 1 then Caption:= 'Browser-Setup';
- end;
-
- procedure TBrowserSetupDlg.UpBttnClick(Sender: TObject);
- var MerkU,MerkB: String;
- MerkS: TUeberschriftObject;
- begin
- if StringGrid1.Row = 1 then Messagebeep(0)
- else begin
- MerkU:= StringGrid1.Cells[0,StringGrid1.Row];
- StringGrid1.Cells[0,StringGrid1.Row]:= StringGrid1.Cells[0,StringGrid1.Row-1];
- StringGrid1.Cells[0,StringGrid1.Row-1]:= MerkU;
- MerkB:= StringGrid1.Cells[1,StringGrid1.Row];
- StringGrid1.Cells[1,StringGrid1.Row]:= StringGrid1.Cells[1,StringGrid1.Row-1];
- StringGrid1.Cells[1,StringGrid1.Row-1]:= MerkB;
- MerkS:= TUeberschriftObject(SortList.Objects[StringGrid1.Row-1]);
- SortList.Objects[StringGrid1.Row-1]:= SortList.Objects[StringGrid1.Row-2];
- SortList.Objects[StringGrid1.Row-2]:= MerkS;
- StringGrid1.Row:= StringGrid1.Row-1;
- end;
- end;
-
- procedure TBrowserSetupDlg.DownBttnClick(Sender: TObject);
- var MerkU,MerkB: String;
- MerkS: TUeberschriftObject;
- begin
- if StringGrid1.Row = StringGrid1.RowCount-1 then Messagebeep(0)
- else begin
- MerkU:= StringGrid1.Cells[0,StringGrid1.Row];
- StringGrid1.Cells[0,StringGrid1.Row]:= StringGrid1.Cells[0,StringGrid1.Row+1];
- StringGrid1.Cells[0,StringGrid1.Row+1]:= MerkU;
- MerkB:= StringGrid1.Cells[1,StringGrid1.Row];
- StringGrid1.Cells[1,StringGrid1.Row]:= StringGrid1.Cells[1,StringGrid1.Row+1];
- StringGrid1.Cells[1,StringGrid1.Row+1]:= MerkB;
- MerkS:= TUeberschriftObject(SortList.Objects[StringGrid1.Row-1]);
- SortList.Objects[StringGrid1.Row-1]:= SortList.Objects[StringGrid1.Row];
- SortList.Objects[StringGrid1.Row]:= MerkS;
- StringGrid1.Row:= StringGrid1.Row+1;
- end;
- end;
-
- procedure TBrowserSetupDlg.FormDestroy(Sender: TObject);
- begin
- SortList.Free;
- end;
-
- procedure TBrowserSetupDlg.OkBttnClick(Sender: TObject);
- var IniFile: TIniFile;
- i: Integer;
- Ueberschr: TUeberschriftObject;
- begin
- IniFile:= TIniFile.Create(ININAME);
- IniFile.EraseSection(BrowserName);
- For i:= 1 to StringGrid1.RowCount-1 do begin
- Ueberschr:= TUeberschriftObject(SortList.Objects[i-1]);
- if Ueberschr <> NIL then begin
- IniFile.WriteString(BrowserName,StringGrid1.Cells[0,i],
- StringGrid1.Cells[1,i]+','+DezStr(Ueberschr.Idx));
- end;
- end;
- IniFile.Free;
- ModalResult:= mrOk;
- end;
-
- Procedure GetArray(AStr: String; var Arr1,Arr2: Integer);
- var A1Str: String;
- A1,A2,Code: Integer;
- begin
- AStr:= UpperCase(AStr);
- Arr1:= 1;
- Arr2:= 1;
- if (Pos('ARRAY[',AStr) > 0) and (Pos('CHAR',Astr) = 0) then begin
- Delete(AStr,1,Pos('ARRAY[',AStr)+5);
- if Pos(']',AStr) > 0 then begin
- AStr:= Copy(AStr,1,Pos(']',AStr)-1);
- if Pos('.',AStr) > 0 then begin
- A1Str:= Copy(AStr,1,Pos('.',AStr)-1);
- While (Pos('.',AStr) > 0) do Delete(AStr,1,Pos('.',AStr));
- Strip(a1Str); Strip(AStr);
- Val(A1Str,A1,Code);
- Val(AStr,A2,Code);
- if (A1 > 0) and (A2 > 0) then begin
- Arr1:= A1;
- Arr2:= A2;
- if Arr1 > Arr2 then begin
- A1:= Arr2;
- Arr2:= Arr1;
- Arr1:= A1;
- end;
- end;
- end;
- end;
- end;
- end;
-
- procedure TBrowserSetupDlg.FormShow(Sender: TObject);
- var IniFile: TIniFile;
- Liste: TStringList;
- Feld,Arr1,Arr2,FNr,Idx,i,Len,Code: Integer;
- X,SStr,FeldName,LenStr: String;
- begin
- if (IniName = '') or (BrowserName = '') then begin
- if Sprache = 1 then Errorwindow('Ini-Filename or BrowserName not assigned','')
- else Errorwindow('INI-Dateiname oder Browsername nicht angegeben','');
- end
- else begin
- IniFile:= TIniFile.Create(IniName);
- Liste:= TStringList.Create;
- IniFile.ReadSection(BrowserName,Liste);
- StringGrid1.Cols[0].Clear;
- StringGrid1.Cols[1].Clear;
- if Sprache = 1 then begin
- StringGrid1.Cols[0].Add('Fieldname');
- StringGrid1.Cols[1].Add('Width');
- end
- else begin
- StringGrid1.Cols[0].Add('â–„berschrift');
- StringGrid1.Cols[1].Add('Breite');
- end;
- if Liste.Count > 0 then begin
- For i:= 0 to Liste.Count-1 do begin
- X:= IniFile.ReadString(BrowserName,Liste[i],'');
- if Pos(',',X) > 0 then begin
- Val(Copy(X,1,Pos(',',X)-1),Len,Code);
- Delete(X,1,Pos(',',X));
- Val(X,Idx,Code);
- end
- else begin
- Idx:= i+1;
- Val(X,Len,Code);
- end;
- SortList.AddObject(Liste[i],TUeberschriftObject.Init(Liste[i],Idx,Len));
- end;
- end
- else begin
- if Table.IsamRecord.Count > 0 then begin
- FNr:= 0;
- For i:= 0 to Table.IsamRecord.Count-1 do begin
- SStr:= Uppercase(Table.IsamRecord[i]);
- if (Pos('DUMMY',Uppercase(SStr)) = 0) and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
- Len:= 0;
- if Pos(':',SStr) > 0 then begin
- GetArray(SStr,Arr1,Arr2);
- For Feld:= Arr1 to Arr2 do begin
- FeldName:= Copy(SStr,1,Pos(':',SStr)-1);
- Strip(FeldName);
- if Arr1 <> Arr2 then FeldName:= FeldName + DezStr(Feld);
- LenStr:= Uppercase(SStr);
- Delete(LenStr,1,Pos(':',LenStr));
- Strip(LenStr);
- if Pos('ARRAY[',LenStr) > 0 then begin
- Delete(LenStr,1,Pos('ARRAY[',LenStr));
- Delete(LenStr,1,Pos(']',LenStr));
- end;
- if Pos('STRING',LenStr) > 0 then begin
- if Pos('[',LenStr) > 0 then begin
- Delete(LenStr,1,Pos('[',LenStr));
- LenStr:= Copy(LenStr,1,Pos(']',LenStr)-1);
- Val(LenStr,Len,Code);
- end
- else Len:= 255;
- end
- else if Pos('INTEGER',LenStr) > 0 then Len:= 8
- else if Pos('WORD',LenStr) > 0 then Len:= 8
- else if Pos('BYTE',LenStr) > 0 then Len:= 4
- else if Pos('LONGINT',LenStr) > 0 then Len:= 10
- else if Pos('BOOLEAN',LenStr) > 0 then Len:= 4
- else if Pos('REAL',LenStr) > 0 then Len:= 10;
- if Len > 0 then begin
- Inc(FNr);
- SortList.AddObject(FeldName,TUeberschriftObject.Init(FeldName,FNr,Len));
- end
- else Errorwindow(FeldName,LenStr);
- end;
- end;
- end;
- end;
- end;
- end;
- if SortList.Count > 0 then begin
- StringGrid1.RowCount:= SortList.Count+1;
- For i:= 0 to SortList.Count-1 do begin
- with TUeberschriftObject(SortList.Objects[i]) do begin
- StringGrid1.Cols[0].Add(Txt);
- Str(Breite,X);
- StringGrid1.Cols[1].Add(X);
- end;
- end;
- end;
- StringGrid1.Row:= 1;
- Liste.Free;
- IniFile.Free;
- end;
- end;
-
- procedure TBrowserSetupDlg.CancelBttnClick(Sender: TObject);
- begin
- ModalResult:= mrCancel;
- end;
-
- Procedure BrowserSetup(aParent: TForm; AppName,BrwName: String;
- Table: TIsamTable);
- var AktDir: String;
- begin
- AktDir:= ExtractFilePath(Application.ExeName);
- BrowserSetupDlg:= TBrowserSetupDlg.Create(aParent);
- Try
- if Pos('.',AppName) > 0 then AppName:= Copy(AppName,1,Pos('.',AppName)-1);
- While Pos('\',AppName) > 0 do Delete(AppName,1,Pos('\',AppName));
- BrowserSetupDlg.IniName:= AktDir + Appname+'.INI';
- BrowserSetupDlg.Browsername:= BrwName;
- BrowserSetupDlg.Table:= Table;
- BrowserSetupDlg.ShowModal;
- Finally
- BrowserSetupDlg.Free;
- end;
- end;
-
- end.
-